home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / pcmagwin.zip / NEWOBJBY.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-05  |  4KB  |  109 lines
  1. UNIT NewObjByType;
  2. {.$define ObjectProfessional}
  3.  
  4. {$ifNdef WINDOWS}
  5.   {$ifNdef VER60}
  6.     {$ifNdef VER55}
  7.       !CRASH! This unit requires Turbo Pascal
  8.        Version 5.5 or 6.0 or Windows
  9.     {$endif}
  10.   {$endif}
  11. {$else}
  12.   {$ifNdef VER10}
  13.     !! This unit requires Turbo Pascal Windows Version 1.0
  14.   {$endif}
  15. {$endif}
  16.  
  17. {$ifdef VER60}
  18.   {$define SYMBOLIC_ASM}
  19. {$endif}
  20. {$ifdef WINDOWS}
  21.   {$define SYMBOLIC_ASM}
  22. {$endif}
  23.  
  24. (**) INTERFACE (**)
  25.  
  26. USES
  27. {$ifdef WINDOWS}
  28.   WObjects;       { Needed to get definition of object type TObject }
  29. {$endif}
  30. {$ifdef VER55}
  31.   OPRoot;         { Needed to get definition of object type Root }
  32.   {$define ROOT}
  33. {$endif}
  34. {$ifdef VER60}
  35.   {$ifdef ObjectProfessional}
  36.   OPRoot;         { Needed to get definition of object type Root }
  37.     {$define ROOT}
  38.   {$else}
  39.   Objects;        { Needed to get definition of object type TObject }
  40.   {$endif}
  41. {$endif}
  42.  
  43. FUNCTION NewByType(VMT      : Pointer;    { Returned by TypeOf   }
  44.                    ConsAddr : Pointer;    { @MyConstructor       }
  45.                    var Data)              { Data for constructor }
  46. {$ifdef ROOT}
  47.                    : RootPtr;  { Returns new obj. pointer  }
  48. {$else}
  49.                    : PObject;  { Returns new obj. pointer  }
  50. {$endif}
  51.  
  52. (**) IMPLEMENTATION (**)
  53.  
  54.   FUNCTION pNewByType(VMTOfs   : Word;   { Only the VMT's DS offset}
  55.                       ConsAddr : Pointer;{ Pass through parameter  }
  56.                       var Data)          { Pass through parameter  }
  57.   {$ifdef ROOT}
  58.                      : RootPtr;  { Returns new obj. pointer  }
  59.   {$else}
  60.                      : PObject;  { Returns new obj. pointer  }
  61.   {$endif}
  62.   BEGIN
  63.   {$ifdef SYMBOLIC_ASM}
  64.     ASM
  65.       Push word [Data+2]          { Push address of untyped        }
  66.       Push word [Data]            { var parameter Data             }
  67.       Push VMTOfs                 { Push value of VMT offset in DS }
  68.       Xor  AX,AX                  { Get ready for a nil 'Self'     }
  69.       Push AX                     { parameter so constructor will  }
  70.       Push AX                     { allocate a new instance        }
  71.       Call [ConsAddr]             { call the constructor           }
  72.       Mov  word [BP-4],AX         { transfer the function return   }
  73.       Mov  word [BP-2],DX         { to place Turbo expects it.     }
  74.     END;
  75.   {$else}
  76.     Inline(
  77.       $FF/$76/<Data+2/            { Push word [Data+2]             }
  78.       $FF/$76/<Data/              { Push word [Data]               }
  79.       $FF/$76/<VMTOfs/            { Push VmtOfs                    }
  80.       $31/$C0/                    { Xor  AX,AX                     }
  81.       $50/                        { Push AX                        }
  82.       $50/                        { Push AX                        }
  83.       $FF/$5E/<ConsAddr/          { Call [ConsAddr]                }
  84.       $89/$46/$FC/                { Mov  word [BP-4],AX            }
  85.       $89/$56/$FE);               { Mov  word [BP-2],DX            }
  86.   {$endif}
  87.   END; { pNewByType }
  88.  
  89.   FUNCTION NewByType(VMT      : Pointer;    { Returned by TypeOf   }
  90.                      ConsAddr : Pointer;    { @MyConstructor       }
  91.                      var Data)              { Data for constructor }
  92.   {$ifdef ROOT}
  93.                      : RootPtr;  { Returns new obj. pointer  }
  94.   {$else}
  95.                      : PObject;  { Returns new obj. pointer  }
  96.   {$endif}
  97.   TYPE
  98.     PointerRecord = RECORD
  99.       Offset,
  100.       Segment : Word;
  101.     END; { PointerRecord}
  102.   BEGIN
  103.     NewByType := pNewByType(PointerRecord(VMT).Offset,
  104.                             ConsAddr,
  105.                             Data);
  106.   END; { NewByType }
  107.  
  108. END. { NewObjByType }
  109.